home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / gcl-1.000 / gcl-1 / gcl-1.0 / c / frame.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-05-07  |  1.7 KB  |  80 lines
  1. /*
  2.  Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa
  3.  
  4. This file is part of GNU Common Lisp, herein referred to as GCL
  5.  
  6. GCL is free software; you can redistribute it and/or modify it under
  7. the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by
  8. the Free Software Foundation; either version 2, or (at your option)
  9. any later version.
  10.  
  11. GCL is distributed in the hope that it will be useful, but WITHOUT
  12. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  13. FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public 
  14. License for more details.
  15.  
  16. You should have received a copy of the GNU Library General Public License 
  17. along with GCL; see the file COPYING.  If not, write to the Free Software
  18. Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20. */
  21.  
  22. /*
  23.  
  24.     frame.c
  25.  
  26.     frame and non-local jump
  27. */
  28.  
  29. #include "include.h"
  30.  
  31. unwind(fr, tag)
  32. frame_ptr fr;
  33. object tag;
  34. {
  35.     nlj_fr = fr;
  36.     nlj_tag = tag;
  37.     nlj_active = TRUE;
  38.     while (frs_top != fr
  39.         && frs_top->frs_class == FRS_CATCH
  40.         /*
  41.         && frs_top->frs_class != FRS_PROTECT
  42.         && frs_top->frs_class != FRS_CATCHALL
  43.         */
  44.           ) {
  45.         --frs_top;
  46.     }
  47.     lex_env = frs_top->frs_lex;
  48.     ihs_top = frs_top->frs_ihs;
  49.     bds_unwind(frs_top->frs_bds_top);
  50.     longjmp(frs_top->frs_jmpbuf, 0);
  51.     /* never reached */
  52. }
  53.  
  54. frame_ptr frs_sch (frame_id)
  55. object frame_id;
  56. {
  57.     frame_ptr top;
  58.  
  59.     for (top = frs_top;  top >= frs_org;  top--)
  60.         if (top->frs_val == frame_id && top->frs_class == FRS_CATCH)
  61.             return(top);
  62.     return(NULL);
  63. }
  64.  
  65. frame_ptr frs_sch_catch(frame_id)
  66. object frame_id;
  67. {
  68.     frame_ptr top;
  69.  
  70.     for(top = frs_top;  top >= frs_org  ;top--)
  71.         if (top->frs_val == frame_id && top->frs_class == FRS_CATCH
  72.             || top->frs_class == FRS_CATCHALL
  73.            )
  74.             return(top);
  75.     return(NULL);
  76. }
  77.  
  78.  
  79.  
  80.